{
  This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
  the Free Software Foundation; version 2 of the License.
   
  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
}

// Copyright (c) 2010 2011 2012 - J. Aldo G. de Freitas Junior

{$mode objfpc}
{$H+}

Unit
	ExprNodes;

Interface

Uses
	Classes,
	SysUtils,
	BaseException,
	Tree,
	Stacks,
	XMLNodes;

Type
	TExprNode = Class;
	TExprNodeClass = Class Of TExprNode;
	TExprNodeList = Array Of TExprNode;

	TExprNode = Class(TTreeNode)
	Private
		fSource : String;
		fRow,
		fCol    : Integer;
		fStack  : TVirtualMachineStack;
		fBroken : Boolean;
	Public
		Procedure RaiseError(Const aMsg : String);
		Procedure EvaluateChilds; Virtual;
		Procedure Evaluate; Virtual;
		Procedure PropagateStack(Const aStack : TVirtualMachineStack);
		Procedure BreakSequence; Virtual;
		Class Function RegisteredName : String; Override;
		Property Source : String Read fSource Write fSource;
		Property Row    : Integer Read fRow Write fRow;
		Property Col    : Integer Read fCol Write fCol;
		Property Stack  : TVirtualMachineStack Read fStack Write fStack;
		Property Broken : Boolean Read fBroken Write fBroken;
	End;

	TUnaryMinusNode = Class(TExprNode)
	Public
		Procedure Evaluate; Override;
	End;

	TUnaryNotNode = Class(TExprNode)
	Public
		Procedure Evaluate; Override;
	End;

	TExpressionListNode = Class;

	TFunctionCallNode = Class(TExprNode)
	Private
		fName : String;
		fParameters : TExpressionListNode;
	Public
		Procedure Evaluate; Override;
		Property Name : String Read fName Write fName;
		Property Parameters : TExpressionListNode Read fParameters Write fParameters;
	End;

	TStringLiteralNode = Class(TExprNode)
	Private
		fValue : String;
	Public
		Procedure Evaluate; Override;
		Property Value : String Read fValue Write fValue;
	End;

	TNumberLiteralNode = Class(TExprNode)
	Private
		fValue : Variant;
		fIsFloat : Boolean;
	Public
		Procedure Evaluate; Override;
		Property Value : Variant Read fValue Write fValue;
		Property IsFloat : Boolean Read fIsFloat Write fIsFloat;
	End;

	TMulExpressionNode = Class(TExprNode)
	Private
		fOperation : String;
	Public
		Procedure Evaluate; Override;
		Property Operation : String Read fOperation Write fOperation;
	End;

	TAddExpressionNode = Class(TExprNode)
	Private
		fOperation : String;
	Public
		Procedure Evaluate; Override;
		Property Operation : String Read fOperation Write fOperation;
	End;

	TExpressionNode = Class(TExprNode)
	Private
		fOperation : String;
	Public
		Procedure Evaluate; Override;
		Property Operation : String Read fOperation Write fOperation;
	End;

	TExpressionListNode = Class(TExprNode)
	Public
		Procedure Evaluate; Override;
	End;
	
	// Command related

	TPropertyNode = Class(TExprNode)
	Private
		fName : String;
		fValue : TExpressionNode;
	Public
		Procedure Evaluate; Override;
		Property Name : String Read fName Write fName;
		Property Value : TExpressionNode Read fValue Write fValue;
	End;

	TPropertyListNode = Class(TExprNode)
	Public
		Procedure Evaluate; Override;
	End;
	
	TNodeNameNode = Class(TExprNode)
	Private
		fName : String;
	Public
		Procedure Evaluate; Override;
		Property Name : String Read fName Write fName;
	End;
	
	TIntrinsicNode = Class(TNodeNameNode)
	Public
		Procedure Evaluate; Override;
	End;
	
	TNumericReferenceNode = Class(TExprNode)
	Private
		fExpression : TExpressionNode;
	Public
		Procedure Evaluate; Override;
		Property Expression : TExpressionNode Read fExpression Write fExpression;
	End;
	
	TExpressionReferenceNode = Class(TExprNode)
	Private
		fProperties : TPropertyListNode;
	Public
		Procedure Evaluate; Override;
		Property Properties : TPropertyListNode Read fProperties Write fProperties;
	End;

	TDomainNameNode = Class(TExprNode)
	Public
		Procedure Evaluate; OVerride;
	End;

	// Basic command structures 
	
	TCommandWithoutParameters = Class(TExprNode);
	
	TCommandWithDomainName = Class(TCommandWithoutParameters)
	Private
		fDOM : TDomainNameNode;
	Public
		Property DomainName : TDomainNameNode Read fDOM Write fDOM;
	End;

	TCommandWithProperties = Class(TCommandWithoutParameters)
	Private
		fProperties : TPropertyListNode;
	Public
		Property Properties : TPropertyListNode Read fProperties Write fProperties;
	End;
	
	TCommandWithClassNameAndProperties = Class(TCommandWithProperties)
	Private
		fClassName : String;
	Public
		Property NameOfClass : String Read fClassName Write fClassName;
	End;
	
	TCommandWithIdentifier = Class(TCommandWithoutParameters)
	Private
		fProperty : String;
	Public
		Property PropertyName : String Read fProperty Write fProperty;
	End;
	
	TCommandWithExpression = Class(TCommandWithoutParameters)
	Private
		fExpression : TExpressionNode;
	Public
		Property Expression : TExpressionNode Read fExpression Write fExpression;
	End;
	
	TCommandWithExpressionList = Class(TCommandWithoutParameters)
	Private
		fExpressionList : TExpressionListNode;
	Public
		Property ExpressionList : TExpressionListNode Read fExpressionList Write fExpressionList;
	End;
	
	TFocusCommand = Class(TCommandWithDomainName)
	Private
		fCommand : TExprNode;
	Public
		Procedure Evaluate; Override;
		Property Command : TExprNode Read fCommand Write fCommand;
	End;
	
	TCommandBlock = Class(TExprNode);
	
	TWhileCommand = Class(TExprNode)
	Private
		fCondition : TExpressionNode;
		fCommand : TExprNode;
	Public
		Procedure Evaluate; Override;
		Procedure BreakSequence; Override;
		Property Condition : TExpressionNode Read fCondition Write fCondition;
		Property Command : TExprNode Read fCommand Write fCommand;
	End;
	
	TIfCommand = Class(TExprNode)
	Private
		fCondition : TExpressionNode;
		fThenCommand : TExprNode;
		fElseCommand : TExprNode;
	Public
		Procedure Evaluate; Override;
		Property Condition : TExpressionNode Read fCondition Write fCondition;
		Property ThenCommand : TExprNode Read fThenCommand Write fThenCommand;
		Property ElseCommand : TExprNode Read fElseCommand Write fElseCommand;
	End;
	
	TForCommand = Class(TExprNode)
	Private
		fNode : TDomainNameNode;
		fCommand : TExprNode;
	Public
		Procedure Evaluate; Override;
		Procedure BreakSequence; Override;
		Property Node : TDomainNameNode Read fNode Write fNode;
		Property Command : TExprNode Read fCommand Write fCommand;
	End;
	
	TBreakCommand = Class(TExprNode)
	Public
		Procedure Evaluate; Override;
	End;
	
	TVarAssignmentCommand = Class(TPropertyNode);

	// Command factory related

	TCommandKind = (
		ckCommandWithoutParameters, 
		ckCommandWithDomainName, 
		ckCommandWithProperties,
		ckCommandWithClassNameAndProperties, 
		ckCommandWithIdentifier, 
		ckCommandWithExpression,
		ckCommandWithExpressionList,
		ckUnknownCommand
	);

	TCommandFactory = Class(TTreeClassFactory)
	Public
		Function CommandKind(Const aName : String): TCommandKind;
		Function Build(Const aClassName : String; Const aOwner : TCommandWithoutParameters): TCommandWithoutParameters; Overload;
	End;

Implementation

// TExprNode

Procedure TExprNode.RaiseError(Const aMsg : String);
Var
	lException : EInterpreterException;
Begin
	lException := EInterpreterException.Create(Row, Col, Source, Nil);
	lException.AddTrace(fRow, fCol, fSource, aMsg);
	Raise lException;
End;

Procedure TExprNode.EvaluateChilds;
Begin
	First;
	fBroken := False;
	While Not(IsAfterLast Or fBroken) Do
	Begin
		// Debug  WriteLn('TExprNode.EvaluateChilds ', GetCurrent.ClassName);
		(GetCurrent As TExprNode).Evaluate;
		Next;
	End;
End;

Procedure TExprNode.PropagateStack(Const aStack : TVirtualMachineStack);
Begin
	fStack := aStack;
	First;
	While Not IsAfterLast Do
	Begin
		(GetCurrent As TExprNode).PropagateStack(aStack);
		Next;
	End;
End;

Procedure TExprNode.BreakSequence;
Begin
	// Debug  WriteLn(IndexedName, ' sequence break.');
	fBroken := True;
	(Owner As TExprNode).BreakSequence
End;

Class Function TExprNode.RegisteredName : String;
Begin
	Result := ClassName;
End;

Procedure TExprNode.Evaluate;
Begin
	// Debug  WriteLn('TExprNode.Evaluate ', Self.ClassName);
	EvaluateChilds;
End;

// TUnaryMinusNode

Procedure TUnaryMinusNode.Evaluate;
Begin
	// Debug  WriteLn(Self.ClassName);
	EvaluateChilds;
	Stack.Top.Push(-1);
	Try
		Stack.DoMul;
	Except
		On E: Exception Do
			Raise EInterpreterException.Create(Row, Col, Source, E);
	End;
End;

// TUnaryNotNode

Procedure TUnaryNotNode.Evaluate;
Begin
	// Debug  WriteLn(Self.ClassName);
	Try
		Stack.DoNot;
	Except
		On E: Exception Do
			Raise EInterpreterException.Create(Row, Col, Source, E);
	End;
End;

// TFunctionCallNode

Procedure TFunctionCallNode.Evaluate;
Begin
	// Debug  WriteLn(Self.ClassName);
	EvaluateChilds;
	Try
		If Assigned(fParameters) Then
			Stack.Enter(Length(fParameters.Childs))
		Else
			Stack.Enter(0);
		Stack.Call(fName);
		Stack.Leave(1);
	Except
		On E: Exception Do
			Raise EInterpreterException.Create(Row, Col, Source, E);
	End;
End;

// TStringLiteralNode

Procedure TStringLiteralNode.Evaluate;
Begin
	// Debug  WriteLn(Self.ClassName);
	Stack.Top.Push(fValue);
End;

// TNumberLiteralNode

Procedure TNumberLiteralNode.Evaluate;
Begin
	// Debug  WriteLn(Self.ClassName);
	If fIsFloat Then
		Stack.Top.Push(StrToFloat(fValue))
	Else
		Stack.Top.Push(StrToInt(fValue));
End;

// TMulExpressionNode

Procedure TMulExpressionNode.Evaluate;
Begin
	// Debug  WriteLn(Self.ClassName);
	EvaluateChilds;
	Try
		If fOperation = '*' Then
			Stack.DoMul
		Else If fOperation = '/' Then
			Stack.DoDiv
		Else If fOperation = 'div' Then
			Stack.DoIDiv
		Else If fOperation = 'mod' Then
			Stack.DoMod
		Else If fOperation = 'and' Then
			Stack.DoAnd
		Else If fOperation = '^' Then
			Stack.DoPow;
	Except
		On E: Exception Do
			Raise EInterpreterException.Create(Row, Col, Source, E);
	End;
End;

// TAddExpressionNode

Procedure TAddExpressionNode.Evaluate;
Begin
	// Debug  WriteLn(Self.ClassName);
	EvaluateChilds;
	Try
		If fOperation = '+' Then
			Stack.DoAdd
		Else If fOperation = '-' Then
			Stack.DoSub
		Else If fOperation = 'or' Then
			Stack.DoOr
		Else If fOperation = 'xor' Then
			Stack.DoXOr;
	Except
		On E: Exception Do
			Raise EInterpreterException.Create(Row, Col, Source, E);
	End;
End;

// TExpressionNode

Procedure TExpressionNode.Evaluate;
Begin
	// Debug  WriteLn(Self.ClassName);
	EvaluateChilds;
	Try
		If fOperation = '=' Then
			Stack.DoCmpEq
		Else If fOperation = '<' Then
			Stack.DoCmpSm
		Else If fOperation = '>' Then
			Stack.DoCmpGt
		Else If fOperation = '<>' Then
			Stack.DoCmpDif
		Else If fOperation = '<=' Then
			Stack.DoCmpEqSm
		Else If fOperation = '>=' Then
			Stack.DoCmpGtSm;
	Except
		On E: Exception Do
			Raise EInterpreterException.Create(Row, Col, Source, E);
	End;
End;

// TExpressionListNode

Procedure TExpressionListNode.Evaluate;
Begin
	// Debug  WriteLn(Self.ClassName);
	EvaluateChilds;
End;

// TPropertyNode

Procedure TPropertyNode.Evaluate;
Begin
	// Debug  WriteLn(Self.ClassName);
	Try
		Stack.Enter(0);
		fValue.Evaluate;
		Stack.NameValue.Top.SetValue(fName, Stack.Top.Pop);
		Stack.Leave(0);
	Except
		On E: Exception Do
			Raise EInterpreterException.Create(Row, Col, Source, E);
	End;
End;

// TPropertyListNode

Procedure TPropertyListNode.Evaluate;
Begin
	// Debug  WriteLn(Self.ClassName);
	Try
		EvaluateChilds;
	Except
		On E: Exception Do
			Raise EInterpreterException.Create(Row, Col, Source, E);
	End;
End;

// TNodeNameNode

Procedure TNodeNameNode.Evaluate;
Begin
	// Debug  WriteLn(Self.ClassName);
	Try
		Stack.Focused := Stack.Focused.Find(Name) As TXMLNode;
	Except
		On E: Exception Do
			Raise EInterpreterException.Create(Row, Col, Source, E);
	End;
End;

// TIntrinsicNode
	
Procedure TIntrinsicNode.Evaluate;
Var
	lName : String;
Begin
	// Debug  WriteLn(Self.ClassName);
	Try
		lName := UpperCase(Name);
		If lName = 'ROOT' Then
			Stack.Focused := Stack.Focused.FindRoot As TXMLNode
		Else If lName = 'FIRST' Then 
			Stack.Focused := Stack.Focused.GetFirst As TXMLNode
		Else If lName = 'CURRENT' Then
			Stack.Focused := Stack.Focused.GetCurrent As TXMLNode
		Else If lName = 'NEXT' Then 
			Stack.Focused := Stack.Focused.GetNext As TXMLNode
		Else If lName = 'PREVIOUS' Then
			Stack.Focused := Stack.Focused.GetPrevious As TXMLNode
		Else If lName = 'LAST' Then
			Stack.Focused := Stack.Focused.GetLast As TXMLNode
		Else If lName = 'CURINC' Then
			Stack.Focused := Stack.Focused.GetCurrentAndIncrement As TXMLNode
		Else If lName = 'CURDEC' Then
			Stack.Focused := Stack.Focused.GetCurrentAndDecrement As TXMLNode
		Else If lName = 'OWNER' Then
			Stack.Focused := Stack.Focused.Owner As TXMLNode
		Else If lName = 'SELF' Then
			Stack.Focused := Stack.Focused
		Else
			RaiseError('Unknown intrinsics : ' + Name);
	Except
		On E: Exception Do
			Raise EInterpreterException.Create(Row, Col, Source, E);
	End;
End;

// TNumericReferenceNode
	
Procedure TNumericReferenceNode.Evaluate;
Begin
	// Debug  WriteLn(Self.ClassName);
	Try
		Stack.Enter(0);
		fExpression.Evaluate;
		Stack.Focused := Stack.Focused.GetChildByNumber(Stack.Top.Pop) As TXMLNode;
		Stack.Leave(0);
	Except
		On E: Exception Do
			Raise EInterpreterException.Create(Row, Col, Source, E);
	End;
End;

// TExpressionReferenceNode

Procedure TExpressionReferenceNode.Evaluate;
Var
	lFound : Boolean;
	lSave  : Integer;
	lNode : TXMLNode;
Begin
	// Debug  WriteLn(Self.ClassName);
	Try
		Try
			lSave := Stack.Focused.GetCurrentIndex;
			Stack.NameValue.Save;
			fProperties.Evaluate;
			Stack.Focused.First;
			lFound := False;
			While Not Stack.Focused.IsAfterLast Do
			Begin
				lFound := Stack.Focused.GetCurrent.Match(Stack.NameValue.Top);
				If lFound Then
					Break;
				Stack.Focused.Next;
			End;
		Finally
			If Not lFound Then
				RaiseError('Cant find the node especified by the expression.')
			Else
			Begin
				lNode := Stack.Focused.GetCurrent As TXMLNode;
				Stack.Focused.SetCurrentIndex(lSave);
				Stack.Focused := lNode;
			End;
			Stack.NameValue.Restore;
		End;
	Except
		On E: Exception Do
			Raise EInterpreterException.Create(Row, Col, Source, E);
	End;
End;

// TDomainNameNode

Procedure TDomainNameNode.Evaluate;
Begin
	// Debug  WriteLn(Self.ClassName);
	Try
		EvaluateChilds;
	Except
		On E: Exception Do
			Raise EInterpreterException.Create(Row, Col, Source, E);
	End;
End;

// TFocusCommand

Procedure TFocusCommand.Evaluate;
Var
	lSave : TXMLNode;
Begin
	// Debug  WriteLn(Self.ClassName);
	Try
		Try
			lSave := Stack.Focused;
			DomainName.Evaluate;
			If Assigned(fCommand) Then
				fCommand.Evaluate;
		Finally
			If Assigned(fCommand) Then
				Stack.Focused := lSave;
		End;
	Except
		On E: Exception Do
			Raise EInterpreterException.Create(Row, Col, Source, E);
	End;
End;

// TWhileCommand

Procedure TWhileCommand.Evaluate;
Begin
	// Debug  WriteLn(Self.ClassName);
	Try
		Broken := False;
		While Not Broken Do
		Begin
			// Debug  WriteLn(IndexedName, ' Iterating');
			Sleep(1);
			fCondition.Evaluate;
			If Stack.Top.Pop Then
				fCommand.Evaluate
			Else
				BreakSequence;
			// Debug  WriteLn(IndexedName, ' Done iterating');
		End;
	Except
		On E: Exception Do
			Raise EInterpreterException.Create(Row, Col, Source, E);
	End;
End;

Procedure TWhileCommand.BreakSequence;
Begin
	// Debug  WriteLn(IndexedName, ' sequence break.');
	Broken := True;
End;

// TIfCommand

Procedure TIfCommand.Evaluate;
Begin
	// Debug  WriteLn(Self.ClassName);
	Try
		fCondition.Evaluate;
		If Stack.Top.Pop Then
			If Assigned(fThenCommand) Then
				fThenCommand.Evaluate
			Else
		Else
			If Assigned(fElseCommand) Then
				fElseCommand.Evaluate;
	Except
		On E: Exception Do
			Raise EInterpreterException.Create(Row, Col, Source, E);
	End;
End;

// TForCommand

Procedure TForCommand.Evaluate;
Var
	lSave,
	lIterate : TXMLNode;
Begin
	// Debug  WriteLn(Self.ClassName);
	Try
		Try
			lSave := Stack.Focused;
			fNode.Evaluate;
			lIterate := Stack.Focused;
			lIterate.First;
			Broken := False;
			While Not(Broken) Do
			Begin
				Stack.Focused := lIterate.GetCurrent As TXMLNode;
				If Assigned(fCommand) Then
					fCommand.Evaluate;
				lIterate.Next;
				If lIterate.IsAfterLast Then
					BreakSequence;
			End;
		Finally
			Stack.Focused := lSave;
		End;
	Except
		On E: Exception Do
			Raise EInterpreterException.Create(Row, Col, Source, E);
	End;
End;

Procedure TForCommand.BreakSequence;
Begin
	// Debug  WriteLn(IndexedName, ' sequence break.');
	Broken := True;
End;

// TBreakCommand

Procedure TBreakCommand.Evaluate;
Begin
	// Debug  WriteLn(Self.ClassName);
	Try
		BreakSequence;
	Except
		On E: Exception Do
			Raise EInterpreterException.Create(Row, Col, Source, E);
	End;
End;

// TCommandFactory

Function TCommandFactory.CommandKind(Const aName : String): TCommandKind;
Var
	lIndex     : Integer;
	lClass     : TTreeNodeClass;
Begin
	lIndex := RegisteredClasses.FindIndexOf(aName);
	If lIndex >= 0 Then
		lClass := TTreeNodeClass(RegisteredClasses.Items[lIndex])
	Else
		lClass := DefaultClass;
	Result := ckUnknownCommand;
	If lClass.InheritsFrom(TCommandWithoutParameters) Then
		Result := ckCommandWithoutParameters;
	If lClass.InheritsFrom(TCommandWithDomainName) Then 
		Result := ckCommandWithDomainName;
	If lClass.InheritsFrom(TCommandWithProperties) Then 
		Result := ckCommandWithProperties;
	If lClass.InheritsFrom(TCommandWithClassNameAndProperties) Then 
		Result := ckCommandWithClassNameAndProperties;
	If lClass.InheritsFrom(TCommandWithIdentifier) Then 
		Result := ckCommandWithIdentifier;
	If lClass.InheritsFrom(TCommandWithExpression) Then 
		Result := ckCommandWithExpression;
	If lClass.InheritsFrom(TCommandWithExpressionList) Then 
		Result := ckCommandWithExpressionList;
End;

Function TCommandFactory.Build(Const aClassName : String; Const aOwner : TCommandWithoutParameters): TCommandWithoutParameters;
Begin
	Result := Build(aClassName, aOwner) As TCommandWithoutParameters;
End;

End.